perm filename M11B.F4[M11,LCS]4 blob sn#409386 filedate 1979-01-09 generic text, type T, neo UTF8
CGEN1      FUNCTION GENERATOR 1 
C    *** MUSIC V ***     
      SUBROUTINEGEN1     
      COMMON I(1)/P/ P(1) /GENS/GENS(1)
	1 /LFUNC/LFUNC
      N1=1+(IFIX(P(4))-1)*LFUNC     
      M1=7 
 102  M=M1+1
      IF(P(M).LE.0)GO TO 103
      V1=P(M1-2)
      V2=(P(M1)-P(M1-2))/(P(M)-P(M1-1))
      MA=N1+IFIX(P(M1-1))
      MB=N1+IFIX(P(M))-1     
      DO 101 J=MA,MB
      XJ=J-MA     
 101  GENS(J)=V1+V2*XJ      
      IF(IFIX(P(M)).EQ.(LFUNC-1))GO TO 103   
      M1=M1+2     
      GO TO 102     
 103  GENS(MB+1)=P(M1)
      RETURN      
      END  

CGEN2      FUNCTION GENERATOR 2 
C    *** MUSIC V ***     
      SUBROUTINEGEN2     
      COMMON I(1)/P/ P(1) /GENS/GENS(1)
	1 /LFUNC/LFUNC
      N1=1+(IFIX(P(4))-1)*LFUNC    
      N2=N1+LFUNC-1      
      DO 101 K1=N1,N2      
 101  GENS(K1)=0.0   
      FAC=6.283185/(FLOAT(LFUNC)-1.0)  
      NMAX=I(1)   
      N3=5+INT(ABS(P(NMAX)))-1  
      IF(N3-5.LT.0)GO TO 104
      DO 103 J=5,N3 
      FACK=FAC*FLOAT(J-4)
      DO 102 K=N1,N2
 102  GENS(K)=GENS(K)+SIN(FACK*FLOAT(K-N1))*P(J)    
 103  CONTINUE    
 104  N4=N3+1     
      N5=I(1)-1   
      IF(N5-N4.LT.0)GO TO 114
      DO 107 J1=N4,N5      
      FACK=FAC*FLOAT(J1-N4)     
      DO 106 K1=N1,N2      
 106  GENS(K1)=GENS(K1)+COS(FACK*FLOAT(K1-N1))*P(J1)
 107  CONTINUE    
114   IF(P(NMAX).LE.0)GO TO 112
      FMAX=0.0    
      DO 110  K2=N1,N2      
      A=ABS(GENS(K2))
110   IF(FMAX.LT.A)FMAX=A
 113  DO 111 K3=N1,N2      
 111  GENS(K3)=GENS(K3)/FMAX  
      RETURN      
112   FMAX=.99999 
      GO TO 113     
      END  

CPARM      CONTROL DATA SPECIFICATION FOR PASS 3     
C    *** MUSIC V ***     
C   
C     IP(1) = NUMBER OF OP CODES
C     IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION  
C     IP(3) = STANDARD SAMPLING RATE   
C     IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS 
C     IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS      
C     IP(6) = LENGTH OF FUNCTIONS      
C     IP(7) = BEGINNING OF NOTE CARD PARAMETERS      
C     IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS   
C     IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS   
C     IP(10)= BEGINNING OF OUTPUT DATA BLOCK  
C     IP(11)= SOUND ZERO (SILENCE VALUE)      
C     IP(12)= SCALE FACTOR FOR NOTE CARD PARAMETERS  
C     IP(13)= BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS    
C     IP(14)= LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS
C     IP(15)= SCALE FACTOR FOR FUNCTIONS      
C   
CS    BLOCK DATA  
CS    COMMON /PARM/IP(20)
CS    DATA IP/12,512,10000, 7100, 7000,512, 6000,35,27,4487,2048,  
CS   1   10     ,4487,512,  "77777  ,5*0/
CCC   DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,  
CCC  1  "1000000,6657,512,"377777777777,5*0/
C*****BIG NUMB. IS IBM360'S BIGGEST.  1  65536,6657,512,Z7FFFFFFF/      
CS    END  


CDSMOUT   DEBUG SAMOUT     'C////'=CHANGES FOR PDP11 VERSION
C *** MUSIC V *** 
C     DEBUG SAMOUT
      SUBROUTINE SAMOUT(IDSK,N)    
	COMMON I(1)  /ROUT/ROUT(1)  /FINOUT/PEAK,IPEAK,NBUF
	1 /CONV/CONV,INIOUT,JFLNM
      DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
 	EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
C*** IDBUF WILL STORE PACKED SAMPLES. ****
CSS      INTEGER PEAK
	IF(INIOUT.EQ.0)GO TO 99
C NOW OPEN PROPER OUTPUT FILE
	INIOUT=0
	IDSK=0
	IF(CONV.EQ.0)GO TO 199
C		CALL PUTFILE('11')
	CALL PUTEXT('TEST','SND')
	NN(1)="525252525252
	NN(2)=I(4)
C I(4)=SRATE, I(8)=NCHNS(-1),  FOR NEXT, 0=12 BIT, 1=18 BIT SMPLS.
	NN(3)="3000001
	NN(4)=I(8)+1
  	NN(5)=64000
	DO 299 K=6,128
299	NN(K)=0
C	CALL FASTOU(NN,128)
	CALL EXTOUT(NN,128)
	GO TO 99
C  OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
CX199X	CALL OPEN(23,'TEST',0,'NEW',,,'UNF')
199   	CALL OFILE(23,'TEST')
99    J=IDSK+1
	M1=1
      M2=0
      IDSK=IDSK+N
C  COUNTS SAMPLES TO DATE
      DO 1 K=J,IDSK
      S=ROUT(M1+M2)
	A=ABS(S)
      IF(A.GT.PEAK)PEAK=A
    	IF(CONV.NE.0)S=S*64.
C *64 TO CONVERT 12 BIT AMPL RANGE TO 16 BIT RANGE.
      IDBUF(K)=S
1     M2=M2+1
      IF(IDSK.LT.NBUF)RETURN
C NBUF=512,MONO   =1024,STEREO

	IF(CONV.EQ.0)GO TO 11
	M=1
	J=NBUF/2
	DO 44 K=1,J

   	NN(K)=(IDBUF(M)*"1000000).OR.(IDBUF(M+1).AND."777777)
C  PACKS 2 SMPLS PER WORD.
CC	NN(K)=IDBUF(M)*262144+IDBUF(M+1)
C 16*262144=4194304
44	M=M+2

CZ     IF(MS(L).LT.0)MS(L)=4096+MS(L)
CZ      IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
C  MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
C  NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
C	CALL FASTOU(NN,J)
	CALL EXTOUT(NN,J)
	GO TO 10

11	WRITE(23)JDBUF
	IF(NBUF.NE.512)WRITE(23),LDBUF
C ABOVE FOR STEREO
10    J=IDSK-NBUF
      IF(J.LT.1)GO TO 4
      DO 5 K=1,J
5     IDBUF(K)=IDBUF(NBUF+K)
4     IDSK=J
      RETURN
      END  

CERRO1     GENERAL ERROR ROUTINE
C    *** MUSIC V ***     
      SUBROUTINE ERROR(I) 
      TYPE 100,I  
  100 FORMAT (' ERROR OF TYPE',I5/)     
      RETURN      
      END